perm filename SAMO2.F4[SAM,LCS] blob sn#437762 filedate 1979-05-01 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	C       SAMO2    FOR INTERACTIVE USE.
C00004 ENDMK
CāŠ—;
C       SAMO2    FOR INTERACTIVE USE.
      SUBROUTINE SAMO2(KKK,J1)    
	COMMON /CONV/A,INIOUT
	DIMENSION L(30),KKK(1),KOUT(512)
	DATA L/"1370600,"2060610,"100,"20140,"10430,
	1 "401025000,"5400,"10000006400,"6200,"400007600,"1210027400,
	1 "401035001,"15401,"10000006401,"6201,"400017601,"1210037401,
	1 "401045002,"25402,"10000006402,"6202,"400027602,"1210047402,
	1 "401055003,"35403,"10000006403,"6203,"400037603,"1210057403,
	1 "430/
	IF(J1.LT.0)GO TO 11
	IF(INIOUT.EQ.0)GO TO 10
C NOW OPEN PROPER OUTPUT FILE
	INIOUT=0
	IDSK=0
	CALL PUTEXT('TEST','SAM')

	DO 1 K=1,30
1	KOUT(K)=L(K)
	J1=J1+30
	N=0
	DO 2 K=31,J1
	N=N+1
2	KOUT(K)=KKK(N)
	IDSK=J1
99	IF(IDSK.LT.128)RETURN
	CALL EXTOUT(KOUT,128)
	DO 3 K=129,IDSK
3	KOUT(K-128)=KOUT(K)
	IDSK=IDSK-128
	IF(IDSK.GE.128)GO TO 99
	RETURN
10	DO 4 K=1,J1
	KOUT(IDSK)=KKK(K)
4	IDSK=IDSK+1
	GO TO 99
11	DO 12 K=IDSK+1,128
12	KOUT(K)=0
	CALL EXTOUT(KOUT,128)
	CALL FINEXT
	END